home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / forms / demotod / demotped.frm < prev    next >
Text File  |  1995-06-09  |  10KB  |  372 lines
  1. VERSION 2.00
  2. Begin Form DemoTipEdit 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Tip of the Day - Editor"
  5.    ClientHeight    =   3300
  6.    ClientLeft      =   2895
  7.    ClientTop       =   2355
  8.    ClientWidth     =   3435
  9.    Height          =   3705
  10.    Icon            =   DEMOTPED.FRX:0000
  11.    Left            =   2835
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   3300
  14.    ScaleWidth      =   3435
  15.    Top             =   2010
  16.    Width           =   3555
  17.    Begin CommandButton Command_Edit 
  18.       Caption         =   "Delete"
  19.       FontBold        =   0   'False
  20.       FontItalic      =   0   'False
  21.       FontName        =   "MS Sans Serif"
  22.       FontSize        =   8.25
  23.       FontStrikethru  =   0   'False
  24.       FontUnderline   =   0   'False
  25.       Height          =   375
  26.       Index           =   1
  27.       Left            =   1740
  28.       TabIndex        =   11
  29.       Top             =   2460
  30.       Width           =   1635
  31.    End
  32.    Begin CommandButton Command_Edit 
  33.       Caption         =   "Add"
  34.       FontBold        =   0   'False
  35.       FontItalic      =   0   'False
  36.       FontName        =   "MS Sans Serif"
  37.       FontSize        =   8.25
  38.       FontStrikethru  =   0   'False
  39.       FontUnderline   =   0   'False
  40.       Height          =   375
  41.       Index           =   0
  42.       Left            =   60
  43.       TabIndex        =   10
  44.       Top             =   2460
  45.       Width           =   1635
  46.    End
  47.    Begin CommandButton Command_Navigate 
  48.       Caption         =   "Last"
  49.       FontBold        =   0   'False
  50.       FontItalic      =   0   'False
  51.       FontName        =   "MS Sans Serif"
  52.       FontSize        =   8.25
  53.       FontStrikethru  =   0   'False
  54.       FontUnderline   =   0   'False
  55.       Height          =   375
  56.       Index           =   3
  57.       Left            =   2580
  58.       TabIndex        =   9
  59.       Top             =   2040
  60.       Width           =   795
  61.    End
  62.    Begin CommandButton Command_Navigate 
  63.       Caption         =   "Next"
  64.       FontBold        =   0   'False
  65.       FontItalic      =   0   'False
  66.       FontName        =   "MS Sans Serif"
  67.       FontSize        =   8.25
  68.       FontStrikethru  =   0   'False
  69.       FontUnderline   =   0   'False
  70.       Height          =   375
  71.       Index           =   2
  72.       Left            =   1740
  73.       TabIndex        =   8
  74.       Top             =   2040
  75.       Width           =   795
  76.    End
  77.    Begin CommandButton Command_Navigate 
  78.       Caption         =   "Previous"
  79.       FontBold        =   0   'False
  80.       FontItalic      =   0   'False
  81.       FontName        =   "MS Sans Serif"
  82.       FontSize        =   8.25
  83.       FontStrikethru  =   0   'False
  84.       FontUnderline   =   0   'False
  85.       Height          =   375
  86.       Index           =   1
  87.       Left            =   840
  88.       TabIndex        =   7
  89.       Top             =   2040
  90.       Width           =   855
  91.    End
  92.    Begin CommandButton Command_Navigate 
  93.       Caption         =   "First"
  94.       FontBold        =   0   'False
  95.       FontItalic      =   0   'False
  96.       FontName        =   "MS Sans Serif"
  97.       FontSize        =   8.25
  98.       FontStrikethru  =   0   'False
  99.       FontUnderline   =   0   'False
  100.       Height          =   375
  101.       Index           =   0
  102.       Left            =   60
  103.       TabIndex        =   6
  104.       Top             =   2040
  105.       Width           =   735
  106.    End
  107.    Begin CommandButton Command_Exit 
  108.       Caption         =   "Exit"
  109.       FontBold        =   0   'False
  110.       FontItalic      =   0   'False
  111.       FontName        =   "MS Sans Serif"
  112.       FontSize        =   8.25
  113.       FontStrikethru  =   0   'False
  114.       FontUnderline   =   0   'False
  115.       Height          =   375
  116.       Left            =   2340
  117.       TabIndex        =   5
  118.       Top             =   2880
  119.       Width           =   1035
  120.    End
  121.    Begin CommandButton Command_Save 
  122.       Caption         =   "Save Tips"
  123.       FontBold        =   0   'False
  124.       FontItalic      =   0   'False
  125.       FontName        =   "MS Sans Serif"
  126.       FontSize        =   8.25
  127.       FontStrikethru  =   0   'False
  128.       FontUnderline   =   0   'False
  129.       Height          =   375
  130.       Left            =   1200
  131.       TabIndex        =   4
  132.       Top             =   2880
  133.       Width           =   1035
  134.    End
  135.    Begin TextBox Text_TipFile 
  136.       FontBold        =   0   'False
  137.       FontItalic      =   0   'False
  138.       FontName        =   "MS Sans Serif"
  139.       FontSize        =   8.25
  140.       FontStrikethru  =   0   'False
  141.       FontUnderline   =   0   'False
  142.       Height          =   285
  143.       Left            =   60
  144.       TabIndex        =   2
  145.       Text            =   "\TOD.TIP"
  146.       Top             =   315
  147.       Width           =   3315
  148.    End
  149.    Begin CommandButton Command_Load 
  150.       Caption         =   "Load Tips"
  151.       FontBold        =   0   'False
  152.       FontItalic      =   0   'False
  153.       FontName        =   "MS Sans Serif"
  154.       FontSize        =   8.25
  155.       FontStrikethru  =   0   'False
  156.       FontUnderline   =   0   'False
  157.       Height          =   375
  158.       Left            =   60
  159.       TabIndex        =   1
  160.       Top             =   2880
  161.       Width           =   1035
  162.    End
  163.    Begin TextBox Text_TOD 
  164.       FontBold        =   0   'False
  165.       FontItalic      =   0   'False
  166.       FontName        =   "MS Sans Serif"
  167.       FontSize        =   8.25
  168.       FontStrikethru  =   0   'False
  169.       FontUnderline   =   0   'False
  170.       Height          =   1305
  171.       Left            =   60
  172.       MultiLine       =   -1  'True
  173.       TabIndex        =   0
  174.       Top             =   645
  175.       Width           =   3315
  176.    End
  177.    Begin Label Label1 
  178.       BackColor       =   &H00C0C0C0&
  179.       Caption         =   "Location and Name of Tip File"
  180.       FontBold        =   0   'False
  181.       FontItalic      =   0   'False
  182.       FontName        =   "MS Sans Serif"
  183.       FontSize        =   8.25
  184.       FontStrikethru  =   0   'False
  185.       FontUnderline   =   0   'False
  186.       Height          =   195
  187.       Left            =   60
  188.       TabIndex        =   3
  189.       Top             =   75
  190.       Width           =   2595
  191.    End
  192. End
  193. Option Explicit
  194.  
  195. Dim FileNum
  196.  
  197. Dim Tips$(500)
  198. Dim TipPos&
  199. Dim TipLen%
  200. Dim NbrTips%
  201. Dim CurrentTip%
  202.  
  203. Sub Command_Edit_Click (Index As Integer)
  204.  
  205.     Select Case Index
  206.         Case 0
  207.             If NbrTips% = 500 Then
  208.                 MsgBox "You have entered the maximum of 500 Tips...", 4, "Sorry"
  209.             Else
  210.                 CurrentTip% = NbrTips%
  211.                 NbrTips% = NbrTips% + 1
  212.                 Text_TOD.Text = Tips$(CurrentTip%)
  213.             End If
  214.         Case 1
  215.             If NbrTips% = 1 Then
  216.                 MsgBox "You cannot delete the last Tip...", 4, "Sorry"
  217.             Else
  218.                 If CurrentTip% = NbrTips% - 1 Then
  219.                     Tips$(CurrentTip%) = ""
  220.                     CurrentTip% = CurrentTip% - 1
  221.                     NbrTips% = NbrTips% - 1
  222.                 Else
  223.                     Shift_Tips
  224.                 End If
  225.                 Text_TOD.Text = Tips$(CurrentTip%)
  226.             End If
  227.     End Select
  228.  
  229.     Set_FPNL
  230.  
  231. End Sub
  232.  
  233. Sub Command_Exit_Click ()
  234.  
  235.     Unload Me
  236.  
  237. End Sub
  238.  
  239. Sub Command_Load_Click ()
  240.  
  241.     FileNum = FreeFile
  242.  
  243.     Open Text_tipFile.Text For Binary As FileNum
  244.  
  245.     TipPos& = 1
  246.     
  247.     NbrTips% = 0
  248.  
  249.     Do
  250.  
  251.         Get FileNum, TipPos&, TipLen%
  252.         Tips$(NbrTips%) = Input$(TipLen%, FileNum)
  253.         TipPos& = Seek(FileNum)
  254.                 
  255.         NbrTips% = NbrTips% + 1
  256.  
  257.     Loop Until TipPos& >= LOF(FileNum)
  258.  
  259.     CurrentTip% = 0
  260.     Text_TOD.Text = Tips$(0)
  261.  
  262.     Close FileNum
  263.  
  264.     Set_FPNL
  265.  
  266. End Sub
  267.  
  268. Sub Command_Navigate_Click (Index As Integer)
  269.  
  270.     Select Case Index
  271.         Case 0
  272.             CurrentTip% = 0
  273.         Case 1
  274.             CurrentTip% = CurrentTip% - 1
  275.         Case 2
  276.             CurrentTip% = CurrentTip% + 1
  277.         Case 3
  278.             CurrentTip% = NbrTips% - 1
  279.     End Select
  280.  
  281.     Text_TOD.Text = Tips$(CurrentTip%)
  282.     
  283.     Set_FPNL
  284.  
  285. End Sub
  286.  
  287. Sub Command_Save_Click ()
  288.  
  289.     Dim i%
  290.  
  291.     On Error Resume Next
  292.     Kill Text_tipFile.Text
  293.     On Error GoTo 0
  294.     
  295.     FileNum = FreeFile
  296.  
  297.     Open Text_tipFile.Text For Binary As FileNum
  298.  
  299.     TipPos& = 1
  300.  
  301.     TipLen% = Len(Tips$(0))
  302.     Put FileNum, TipPos&, TipLen%
  303.     Put FileNum, , Tips$(0)
  304.     
  305.     If NbrTips% > 1 Then
  306.         For i% = 1 To NbrTips% - 1
  307.             TipLen% = Len(Tips$(i%))
  308.             Put FileNum, , TipLen%
  309.             Put FileNum, , Tips$(i%)
  310.         Next i%
  311.     End If
  312.  
  313.     Close FileNum
  314.  
  315. End Sub
  316.  
  317. Sub Form_Load ()
  318.  
  319.     Text_tipFile.Text = App.Path & Text_tipFile.Text
  320.  
  321.     Command_Load_Click
  322.  
  323.     Set_FPNL
  324.  
  325. End Sub
  326.  
  327. Sub Set_FPNL ()
  328.  
  329.     If NbrTips% = 0 Then
  330.         Command_Navigate(0).Enabled = False
  331.         Command_Navigate(1).Enabled = False
  332.         Command_Navigate(2).Enabled = False
  333.         Command_Navigate(3).Enabled = False
  334.         Exit Sub
  335.     Else
  336.         Command_Navigate(0).Enabled = True
  337.         Command_Navigate(1).Enabled = True
  338.         Command_Navigate(2).Enabled = True
  339.         Command_Navigate(3).Enabled = True
  340.     End If
  341.  
  342.     If CurrentTip% + 2 > NbrTips% Then
  343.         Command_Navigate(2).Enabled = False
  344.     End If
  345.  
  346.     If CurrentTip% = 0 Then
  347.         Command_Navigate(1).Enabled = False
  348.     End If
  349.  
  350. End Sub
  351.  
  352. Sub Shift_Tips ()
  353.  
  354.     Dim i%
  355.  
  356.     For i% = CurrentTip% + 1 To NbrTips% - 1
  357.         Tips$(i% - 1) = Tips$(i%)
  358.     Next i%
  359.     
  360.     Tips$(NbrTips% - 1) = ""
  361.  
  362.     NbrTips% = NbrTips% - 1
  363.  
  364. End Sub
  365.  
  366. Sub Text_TOD_LostFocus ()
  367.  
  368.     Tips$(CurrentTip%) = Text_TOD.Text
  369.  
  370. End Sub
  371.  
  372.